home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1995 November / Macworld Nov ’95.toast / Developers / Selection ƒ 2.5 / te < prev    next >
Encoding:
Text File  |  1994-11-06  |  6.2 KB  |  294 lines  |  [TEXT/MSET]
  1.  \ 25Dec93 DBH made font the superclass
  2.  \ 28Oct94 dbh updated to 2.5 syntax 
  3.  
  4. (*
  5.  
  6. Note that we normally would subclass from te, as we do in tebox and tescroll.
  7. A te is a selection object and perhaps is one of the best examples of the 
  8. advantages of using the selection framework.  We can have as many te objects
  9. as we wish in a window and they will all behave as expected in that each
  10. must first be selected with the mouse and then keystrokes may be received.
  11. The selection framework does not allow passing keystrokes to more than one
  12. object at a time, keystrokes are only passed to the currently selected object.
  13.  
  14. Also note that the clipboard is supported (automatically).
  15.  
  16. *)
  17.  
  18.  
  19. :CLASS te super{ font }
  20. \ some ivars for initial values
  21.     rect+    destRect
  22.     rect+    viewRect
  23.     handle    TEHandle
  24.     
  25.  
  26.  
  27. \ ***** SAFE METHODS  (can be called without concern to being alive)
  28.  
  29. :m alive?:  ( -- b )
  30.     nil?: TEHandle not ;m
  31.  
  32. :m view:  ( -- l t r b )
  33.     get: viewRect ;m    \ we always maintain this, so will work when alive
  34.  
  35. :m setview: { l t r b -- }
  36.     l t r b put: viewRect
  37.     alive?: self
  38.     IF
  39.         l t r b ptr: TEHandle  setview: terec
  40.     THEN ;m
  41.  
  42. :m dest:  ( -- l t r b )
  43.     get: destRect ;m    \ we always maintain this, so will work when alive
  44.                         \ ????  does this really work when alive??     \ 24May93 DBH
  45.  
  46. :m setdest: { l t r b -- }
  47.     l t r b put: destRect
  48.     alive?: self
  49.     IF
  50.         l t r b ptr: TEHandle  setdest: terec
  51.     THEN ;m
  52.  
  53. :m setrects: { l t r b -- }
  54.     l t r b setdest: self
  55.     l t r b setview: self ;m
  56.  
  57. :m classinit:
  58.     20 20 50 50 setdest: self
  59.     20 20 50 50 setview: self
  60.     ;m
  61.  
  62. :m moveto:    { l t -- }
  63.     l t moveto: destRect
  64.     l t moveto: viewrect
  65.     alive?: self
  66.     IF
  67.         l t  ptr: TEHandle  moveto: teRec    \ note message to class
  68.     THEN
  69.     ;m
  70.  
  71. :m move:    { dx dy -- }
  72.     dx dy move: destRect
  73.     dx dy move: viewRect
  74.     alive?: self
  75.     IF
  76.         dx dy  ptr: TEHandle  move: teRec    \ note message to class
  77.     THEN
  78.     ;m
  79.  
  80. :m hit?: \ ( -- b )
  81.     where: theMouse
  82.     viewRect  PtInRect ;m
  83.  
  84. :m focus?: ( -- t ) true ;m
  85.  
  86. :m alwaysActive?:  ( -- f )  false ;m
  87.  
  88. :m new:  ( wptr -- ) drop    \ stay consistent with select prototcol
  89.     getnew: super> font
  90.     set: super> font     \ 28Dec93 dbh \ 29Oct94 dbh
  91.     0    \ space for returned handle
  92.     destRect
  93.     viewRect
  94.     call TENew
  95.     put: TEHandle
  96.     ;m
  97.  
  98.  
  99. \ *** UNSAFE METHODS (must only be called when alive)
  100. :m handle:    ( -- tehandle )
  101.     get: TEHandle ;m
  102.  
  103. :m ptr:    ( -- terec )
  104.     ptr: TEHandle ;m
  105.  
  106. :m noWrap:
  107.     ptr: self noWrap: teRec ;m
  108.  
  109. :m setlineHeight:    ( n -- )
  110.     ptr: TEHandle setlineHeight: teRec ;m
  111.  
  112.  :m LINEHEIGHT:  ( -- n )
  113.     ptr: TEHandle lineHeight: teRec ;m
  114.  
  115. :m cut:
  116.     get: TEHandle call TECut
  117.     todesk  drop ;m \ not looking at error
  118.  
  119. :m copy:
  120.     get: TEHandle call TECopy
  121.     todesk drop ;m \ not looking at error
  122.  
  123. :m paste:
  124.     fromdesk IF exit THEN \ out if error
  125.     get: TEHandle call TEPaste ;m
  126.  
  127. :m clear:
  128.     get: TEHandle call TEDelete ;m
  129.  
  130. :m draw:
  131. \    addr: viewRect call ClipRect    \ 01May93 DBH
  132.     clear: viewRect        \ per IM I-387, call EraseRect
  133.     viewRect  get: TEHandle call TEUpdate
  134.     ;m
  135.  
  136. :m size: ( -- len )  \ returns the length of the text
  137.     ptr: TEHandle  size: teRec ;m         \ note message to class
  138.  
  139. :m textaddr:        ( -- $addr )    \ addr of the first char of the TE text
  140.     0 get: TEHandle call TEGetText @ ( $addr ) ;m
  141.  
  142. :m get:    ( -- $addr len )
  143.     textaddr: self
  144.     size: self ;m
  145.  
  146. :m put: ( $addr len -- )
  147.     get: TEHandle  call TESetText
  148.     draw: self
  149.     ;m
  150.  
  151. :m insert: ( $addr len -- )
  152.     get: TEHandle  call TEInsert
  153.     ;m
  154.  
  155. :m activate:
  156.     get: TEHandle  call TEActivate ;m
  157.  
  158. :m deactivate:
  159.     get: TEHandle  call TEDeactivate ;m
  160.  
  161. :m release:
  162.     get: TEHandle call TEDispose
  163.     clear: TEHandle ;m
  164.  
  165. :m idle:
  166.     get: TEHandle call TEIdle
  167.     where: theMouse
  168.     viewRect  PtInRect
  169.     IF    ibeamcurs
  170.     ELSE initCursor
  171.     THEN
  172.     ;m
  173.  
  174. :m click:
  175.     where: theMouse pack  ( point)
  176.     mods: fevent $ 200 and makeint \ extend if shift key
  177.     get: TEHandle
  178.     call TEclick
  179.     ;m
  180.  
  181. :m key:    \ ( char -- )
  182.     makeint
  183.     get: TEHandle
  184.     call TEKey ;m
  185.  
  186. :m select:  ( start end -- )  \ hilites the given range
  187.     get: TEHandle  call TESetSelect ;m
  188.  
  189. :m selectAll:  \ hilites all of the text
  190.     0 ( start)
  191.     size: self  ( end)
  192.     select: self ;m
  193.  
  194. :m selStart:  ( -- n )
  195.     ptr: TEHandle selStart: terec ;m
  196.  
  197. :m selEnd:  ( -- n )
  198.     ptr: TEHandle selEnd: terec ;m
  199.  
  200. \ :m addrLineStart:  ( -- addr )
  201. \    ptr: TEHandle addrLineStart: terec ;m
  202.  
  203. :m lastchar:  ( -- char )    \ return last character in TE
  204.     textaddr: self  size: self 1- + c@ ;m
  205.  
  206. 0 value kludge
  207.  
  208. :m #lines:    ( -- n)
  209.     0 -> kludge
  210.     ptr: TEHandle  #lines: teRec    \ note message to class
  211.     lastchar: self  ret = IF -1 -> kludge 1+ THEN    \ kludge Apple line numbering scheme!!
  212.     ;m
  213.  
  214. \ given the zero-based line number, return the character# of the start of that line
  215. :m at:  { n -- linestart }
  216.     n kludge + 1 +  #lines: self > abort" TE linestart index out of range"
  217.     
  218.     ptr: TEHandle addrLineStart: teRec  n 2 * + w@ ;m
  219.  
  220. :m GETPOINT:  { offset -- x y }    \ given the char offset into the text, return the
  221.                                 \ corresponding x y location  See IM V-269.
  222.     0 offset makeint get: TEHandle call TEGetPoint  unpack ;m
  223.  
  224. :m currentLine:     ( -- n )    \ **
  225.     selend: self GETPOINT: self  ( x y ) nip          ( cursor.y )
  226.     ptr: TEHandle ( dest) gettopy: rect  -        ( cursor.y - dest.top )
  227.     
  228.     lineheight: self / 1-
  229.     
  230.     selend: self  size: self =     \ true if at last char
  231.     size: self  and    \ and if not an empty size
  232.     IF
  233.         lastchar: self  ret =
  234.         IF    \ uh-oh, handle special case where last char is a ret
  235.             1+
  236.         THEN
  237.     THEN
  238.     ;m
  239.  
  240. :m getLine:  { \ l -- addr len }
  241.     size: self 0= IF pad 0 exit    THEN \ return nil and get out if no text
  242.     currentLine: self -> l
  243.     #lines: self 1 - l =
  244.     IF    \ we are on the last line
  245.  
  246.         lastchar: self    \ **
  247.         ret =
  248.             IF \ we are on the last line AND just beyond a carriage return!
  249.                 pad 0 exit    \ return nil and get out here
  250.             THEN
  251.  
  252.         textaddr: self  l at: self + ( addr) \ **
  253.         size: self
  254.         l at: self -  ( len)
  255.     
  256.     ELSE
  257.     
  258.         textaddr: self  l at: self + ( addr) \ **
  259.         
  260.         l 1 + at: self
  261.         l at: self - 1 - ( len)
  262.     THEN
  263.     ;m
  264.  
  265. :m getselect: ( -- addr len )    \ returns hilited selection
  266.     ptr: TEHandle    getselect: terec ;m
  267.  
  268.  
  269. :m LINEEND: { \ len pos -- pos }    \ return the character position corresponding to the
  270.                             \ end of the last line of the current selection.
  271.     selend: self size: self =
  272.     IF    \ we are at the end of the text
  273.         size: self
  274.     ELSE
  275.         currentline: self  at: self  ( linestart ) -> pos
  276.         getline: self nip -> len
  277.         pos len +
  278.     THEN ;m
  279.  
  280. ;CLASS
  281.  
  282. endload
  283.  
  284. *** EXAMPLE USE
  285.  
  286.  
  287. selwindow w
  288. test: w
  289.  
  290. te t
  291. t add: w
  292.  
  293. " Hi Bye" insert: t
  294.